000100 IDENTIFICATION DIVISION.                                         00010000
000200 PROGRAM-ID.      HHCAL016.                                       00020014
000300*AUTHOR.          DAVE PANUSKA                                    00030000
000400*REMARKS.         (HEALTH CARE FINANCING ADMINISTRATION)          00040000
000500*REMARKS. A). NATIONAL HHA PRICER                                 00050000
000600***       B). NATIONAL HHA PRICER EFFECTIVE OCT 1 2000            00060000
000700***       C). HHA PRICER REFERS TO A PROGRAM WHICH WILL           00070000
000800***           CALCULATE THE HRG'S,REVENUE CODES AND               00080000
000900***           TYPE OF BILLS.                                      00090000
001000*REMARKS.                                                         00100000
001100*     HHCAL010   NATIONAL HHA FOR OCT 1, 2000                     00110000
001200*     HHCAL012   NEW RATE EFFECTIVE APR 1, 2001                   00120002
001300*     HHCAL013   CORRECT CALCULATIONS FOR PEP ADJUSTMENTS         00130002
001310*     HHCAL014 EXPAND BILLING RECORD TO 500 BYTES - BEATA VERSION 00131010
001320*     HHCAL015 INCREASE PROV-PAYMET-TOTAL TO  PIC 9(09)V9(02)     00132010
001330*     HHCAL016 ADD NEW FIELDS FOR ONSET DATES                     00133014
001400******************************************************************00140000
001410*----------------------------------------------------------------*00141017
001420* 2016 - ADDED 32Q AND 33Q AS VALID TOB CODES IN PARAGRAPH       *00142017
001430*        400-CALC-THE-HHA                                        *00143017
001440*----------------------------------------------------------------*00144017
001600******************************************************************00160000
001700*            RETURN CODE VALUES (HHA-RTC)                         00170000
001800*                                                                 00180000
001900*        HHA-RTC  WITH PAYMENTS RETURNED                          00190000
002000*                                                                 00200000
002100*     RETURN CODES                                                00210000
002200*          00 = FINAL PAYMENT                                     00220000
002300*               TOB = 329,339,327,337                             00230000
002400*                  OR 32G OR 33G OR 32I OR 33I                    00240000
002500*                  OR 32J OR 33J OR 32M OR 33M                    00250000
002600*                  OR 32F OR 32K OR 32P OR 32H                    00260000
002700*                  OR 33F OR 33K OR 33P OR 33H                    00270000
002710*                  OR 32Q OR 33Q                                  00271018
002800*               WITH HRG,REVENUE CODE WHERE NO OUTLIER APPLIES    00280000
002900*          01 = FINAL PAYMENT                                     00290000
003000*               TOB = 329,339,327,337                             00300000
003100*                  OR 32G OR 33G OR 32I OR 33I                    00310000
003200*                  OR 32J OR 33J OR 32M OR 33M                    00320000
003300*                  OR 32F OR 32K OR 32P OR 32H                    00330000
003400*                  OR 33F OR 33K OR 33P OR 33H                    00340000
003410*                  OR 32Q OR 33Q                                  00341018
003500*               WITH HRG,REVENUE CODE WHERE OUTLIER APPLIES       00350000
003600*          03 = INITIAL HALF PAYMENT PAYMENT WILL BE ZERO         00360000
003700*               TOB = 332 AND 322                                 00370000
003800*          04 = INITIAL HALF PAYMENT PAID AT 50%                  00380000
003900*               TOB = 332 AND 322                                 00390000
004000*               WITH INITIAL (FIRST) HRG AND NO REVENUE CODES     00400000
004100*          05 = INITIAL HALF PAYMENT PAID AT 60%                  00410000
004200*               TOB = 332 AND 322                                 00420000
004300*               WITH INITIAL (FIRST) HRG AND NO REVENUE CODES     00430000
004400*          06 = LUPA PAYMENT ONLY                                 00440000
004500*               TOB = 329,339,327,337                             00450000
004600*                  OR 32G OR 33G OR 32I OR 33I                    00460000
004700*                  OR 32J OR 33J OR 32M OR 33M                    00470000
004800*                  OR 32F OR 32K OR 32P OR 32H                    00480000
004900*                  OR 33F OR 33K OR 33P OR 33H                    00490000
004910*                  OR 32Q OR 33Q                                  00491018
005000*               WITH REVENUE CODES AND REVENUE QTYS < 5       *   00500000
005100*                                                             *   00510000
005200*            HHA-RTC   NO PAYMENTS RETURNED                   *   00520000
005300*                                                             *   00530000
005400*              10 = INVALID TOB                               *   00540000
005500*                                                             *   00550000
005600*              15 = INVALID PEP DAYS                          *   00560000
005700*                   FOR SHORTENED EPISODE                     *   00570000
005800*                                                             *   00580000
005900*              20 = INVALID PEP INDICATOR                     *   00590000
006000*                                                             *   00600000
006100*              25 = INVALID MED REVIEW INDICATOR              *   00610000
006200*                                                             *   00620000
006300*              30 = INVALID MSA CODE                          *   00630000
006400*                                                             *   00640000
006500*              35 = INVALID INITIAL PAYMENT INDICATOR         *   00650000
006600*                        0 = MAKE NORMAL INITIAL PAYMENT      *   00660000
006700*                        1 = MAKE ZERO PAYMANT                *   00670000
006800*                                                             *   00680000
006900*              40 = FROM DATE  < OCT 1, 2000 OR INVALID       *   00690000
007000*                   THRU DATE  < OCT 1, 2000 OR INVALID       *   00700000
007100*                   ADMIT DATE < OCT 1, 2000 OR INVALID       *   00710000
007200*                                                             *   00720000
007300*              70 = INVALID OR NO HRG CODE PRESENT            *   00730000
007400*                                                             *   00740000
007500*              75 = NO HRG PRESENT IN FIRST OCCURANCE AND     *   00750000
007600*                   REVENUE-QTY-COV-VISITS > 4  AND           *   00760000
007700*                    TOB = 329,339,327,337                 *      00770018
007710*                          OR 32Q OR 33Q                          00771018
007800*                          OR 32G OR 33G OR 32I OR 33I        *   00780000
007900*                          OR 32J OR 33J OR 32M OR 33M        *   00790000
008000*                          OR 32F OR 32K OR 32P OR 32H            00800000
008100*                          OR 33F OR 33K OR 33P OR 33H            00810000
008200*                                                             *   00820000
008300*              80 = INVALID REVENUE CODE                      *   00830000
008400*                                                             *   00840000
008500*              85 = NO REVENUE CODE PRESENT                   *   00850000
008600*                   WITH TOB 329 OR 339 OR 327 OR 337         *   00860000
008610*                          OR 32Q OR 33Q                          00861018
008700*                         OR 32G OR 33G OR 32I OR 33I         *   00870000
008800*                         OR 32J OR 33J OR 32M OR 33M         *   00880000
008900*                         OR 32F OR 32K OR 32P OR 32H             00890000
009000*                         OR 33F OR 33K OR 33P OR 33H             00900000
009100*                                                             *   00910000
009200***************************************************************   00920000
009300***************************************************************   00930000
009400***************************************************************   00940000
009500 DATE-COMPILED.                                                   00950000
009600 ENVIRONMENT DIVISION.                                            00960000
009700 CONFIGURATION SECTION.                                           00970000
009800 SOURCE-COMPUTER.            IBM-370.                             00980000
009900 OBJECT-COMPUTER.            IBM-370.                             00990000
010000 INPUT-OUTPUT  SECTION.                                           01000000
010100 FILE-CONTROL.                                                    01010000
010200                                                                  01020000
010300 DATA DIVISION.                                                   01030000
010400 FILE SECTION.                                                    01040000
010500                                                                  01050000
010600 WORKING-STORAGE SECTION.                                         01060000
010700 01  W-STORAGE-REF                  PIC X(46)  VALUE              01070000
010800     'HHCAL016      - W O R K I N G   S T O R A G E'.             01080014
010900 01  CAL-VERSION                    PIC X(07)  VALUE 'C2001.6'.   01090014
011000 01  CO1                            PIC S9(04) COMP SYNC.         01100000
011100 01  SUB1                           PIC S9(04) COMP SYNC.         01110000
011200 01  R1                             PIC S9(04) COMP SYNC.         01120000
011300 01  R2                             PIC S9(04) COMP SYNC.         01130000
011400 01  R3                             PIC S9(04) COMP SYNC.         01140000
011500                                                                  01150000
011600 01  LABOR-NLABOR-PERCENT.                                        01160000
011700     05 LABOR-PERCENT        PIC 9V9(05)  VALUE 0.77668.          01170000
011800     05 NONLABOR-PERCENT     PIC 9V9(05)  VALUE 0.22332.          01180000
011900                                                                  01190000
012000 01  FED-EPISODE-RATE-AMT         PIC 9(05)V9(02) VALUE 0.        01200000
012100 01  OUTLIER-THRESHOLD-AMT        PIC 9(05)V9(02) VALUE 0.        01210000
012200***************************************************************** 01220000
012300***    EXAMPLE    *********************************************** 01230000
012400*** FED-EPISODE-RATE-AMT TIMES 1.13 = OUTLIER-THRESHOLD-AMT ***** 01240000
012500******  2115.30 TIMES 1.13  = 2390.29  ROUNDED UP  ************** 01250000
012600***************************************************************** 01260000
012700 01  OUTL-LOSS-SHAR-RATIO-PERCENT PIC 9(01)V9(02) VALUE 0.80.     01270000
012800                                                                  01280000
012900 01  WK-HRG-NO-OF-DAYS            PIC S9(03)V9(07) VALUE 0.       01290000
013000 01  WK-PEP-DAYS                  PIC S9(03)V9(07) VALUE 0.       01300000
013100                                                                  01310000
013200 01  WK-ALL-TOTALS.                                               01320000
013300     05  FED-ADJ                        PIC S9(07)V9(02).         01330000
013400     05  FED-LABOR-ADJ                  PIC S9(07)V9(02).         01340000
013500     05  FED-NON-LABOR-ADJ              PIC S9(07)V9(02).         01350000
013600     05  OUT-THRES-AMT-ADJ              PIC S9(07)V9(02).         01360000
013700     05  OUT-THRES-LABOR-ADJ            PIC S9(07)V9(02).         01370000
013800     05  OUT-THRES-NON-LABOR-ADJ        PIC S9(07)V9(02).         01380000
013900     05  WK-3000-PEP-N-PRETOT-PAY       PIC S9(07)V9(02).         01390000
014000     05  WK-3000-PEP-N-PAYMENT          PIC S9(07)V9(02).         01400000
014100     05  WK-4000-PEP-Y-PRETOT-PAY       PIC S9(07)V9(02).         01410000
014200     05  WK-4000-PEP-Y-PAYMENT          PIC S9(07)V9(02).         01420000
014300     05  WK-5000-PEP-N-PRETOT-PAY       PIC S9(07)V9(02).         01430000
014400     05  WK-5000-PEP-N-PAYMENT          PIC S9(07)V9(02).         01440000
014500     05  WK-6000-PEP-Y-PRETOT-PAY       PIC S9(07)V9(02).         01450000
014600     05  WK-6000-PEP-Y-PAYMENT          PIC S9(07)V9(02).         01460000
014700     05  WK-6050-PEP-Y-TOT-DAYS         PIC S9(04).               01470000
014800     05  WK-7000-OUTLIER-VALUE-A        PIC S9(07)V9(02).         01480000
014900     05  WK-7000-AB-DIFF                PIC S9(07)V9(02).         01490000
015000     05  WK-7000-CALC                   PIC S9(07)V9(02).         01500000
015100     05  WK-8000-OUTLIER-VALUE-B        PIC S9(07)V9(02).         01510000
015200     05  WK-8000-OUTLIER-LAB-NLAB       PIC S9(07)V9(02).         01520000
015300                                                                  01530000
015400                                                                  01540000
015500                                                                  01550000
015600*******************************************************           01560000
015700 01  HOLD-HHA-DATA.                                               01570000
015800     05  H-HHA-INPUT-DATA.                                        01580000
015900         10  H-HHA-NPI                 PIC X(10).                 01590000
016000         10  H-HHA-HIC                 PIC X(12).                 01600000
016100         10  H-HHA-PROV-NO             PIC X(06).                 01610000
016200         10  H-HHA-TOB                 PIC XXX.                   01620000
016300         10  H-HHA-PEP-INDICATOR       PIC X.                     01630000
016400         10  H-HHA-PEP-DAYS            PIC 999.                   01640000
016500         10  H-HHA-INIT-PAY-INDICATOR  PIC X.                     01650000
016600         10  FILLER                    PIC X(07).                 01660000
016700         10  H-HHA-MSA1                PIC 9(07)V9(02).           01670000
016800         10  H-HHA-MSA2-DATA REDEFINES H-HHA-MSA1.                01680000
016900             15  FILLER             PIC XXX.                      01690000
017000             15  H-HHA-MSA2           PIC XXXX.                   01700000
017100             15  FILLER             PIC XX.                       01710000
017200         10  H-HHA-SERV-FROM-DATE.                                01720000
017300             15  H-HHA-FROM-CC         PIC XX.                    01730000
017400             15  H-HHA-FROM-YYMMDD.                               01740000
017500                 25  H-HHA-FROM-YY     PIC XX.                    01750000
017600                 25  H-HHA-FROM-MM     PIC XX.                    01760000
017700                 25  H-HHA-FROM-DD     PIC XX.                    01770000
017800         10  H-HHA-SERV-THRU-DATE.                                01780000
017900             15  H-HHA-THRU-CC         PIC XX.                    01790000
018000             15  H-HHA-THRU-YYMMDD.                               01800000
018100                 25  H-HHA-THRU-YY     PIC XX.                    01810000
018200                 25  H-HHA-THRU-MM     PIC XX.                    01820000
018300                 25  H-HHA-THRU-DD     PIC XX.                    01830000
018400         10  H-HHA-ADMIT-DATE.                                    01840000
018500             15  H-HHA-ADMIT-CC        PIC XX.                    01850000
018600             15  H-HHA-ADMIT-YYMMDD.                              01860000
018700                 25  H-HHA-ADMIT-YY    PIC XX.                    01870000
018800                 25  H-HHA-ADMIT-MM    PIC XX.                    01880000
018900                 25  H-HHA-ADMIT-DD    PIC XX.                    01890000
019000         10  H-HHA-HRG-DATA      OCCURS 6.                        01900000
019100             15  H-HHA-MED-REVIEW-INDICATOR PIC X.                01910000
019200             15  H-HHA-HRG-INPUT-CODE       PIC X(05).            01920000
019300             15  H-HHA-HRG-OUTPUT-CODE      PIC X(05).            01930000
019400             15  H-HHA-HRG-NO-OF-DAYS       PIC 9(03).            01940000
019500             15  H-HHA-HRG-WGTS             PIC 9(02)V9(04).      01950000
019600             15  H-HHA-HRG-PAY              PIC 9(07)V9(02).      01960000
019700         10  H-HHA-REVENUE-DATA     OCCURS 6.                     01970000
019800             15  H-HHA-REVENUE-CODE             PIC X(04).        01980013
019900             15  H-HHA-REVENUE-QTY-COV-VISITS   PIC 9(03).        01990013
019910             15  H-HHA-REVENUE-EARLIEST-DATE    PIC 9(08).        01991013
020000             15  H-HHA-REVENUE-DOLL-RATE        PIC 9(07)V9(02).  02000013
020100             15  H-HHA-REVENUE-COST             PIC 9(07)V9(02).  02010013
020120             15  H-HHA-REVENUE-ADD-ON-VISIT-AMT PIC 9(07)V9(02).  02012013
020200     05  H-HHA-PASSBACK-DATA.                                     02020000
020300         10  H-HHA-PAY-RTC                PIC 99.                 02030000
020400         10  H-HHA-REVENUE-SUM1-3-QTY-THR PIC 9(05).              02040000
020500         10  H-HHA-REVENUE-SUM1-6-QTY-ALL PIC 9(05).              02050000
020600         10  H-HHA-OUTLIER-PAYMENT        PIC 9(07)V9(02).        02060000
020700         10  H-HHA-TOTAL-PAYMENT          PIC 9(07)V9(02).        02070000
020710     05  H-HHA-CASE-MIX-DATA.                                     02071006
020720         10  H-HHA-LUPA-ADD-ON-PAYMENT    PIC 9(03)V9(02).        02072006
020730         10  H-HHA-LUPA-SRC-ADM           PIC X.                  02073006
020740         10  H-HHA-RECODE-IND             PIC X.                  02074006
020750         10  H-HHA-EPISODE-TIMING         PIC 9.                  02075006
020760         10  H-HHA-SEVERITY-POINTS.                               02076006
020770             15  H-HHA-CLINICAL-SEV-EQ1   PIC X(01).              02077006
020780             15  H-HHA-FUNCTION-SEV-EQ1   PIC X(01).              02078006
020790             15  H-HHA-CLINICAL-SEV-EQ2   PIC X(01).              02079006
020791             15  H-HHA-FUNCTION-SEV-EQ2   PIC X(01).              02079106
020792             15  H-HHA-CLINICAL-SEV-EQ3   PIC X(01).              02079206
020793             15  H-HHA-FUNCTION-SEV-EQ3   PIC X(01).              02079306
020794             15  H-HHA-CLINICAL-SEV-EQ4   PIC X(01).              02079406
020795             15  H-HHA-FUNCTION-SEV-EQ4   PIC X(01).              02079506
020796     05  H-HHA-PROV-TOTAL-DATA.                                   02079606
020797         10  H-HHA-PROV-OUTLIER-PAY-TOTAL PIC 9(08)V9(02).        02079706
020798         10  H-HHA-PROV-PAYMET-TOTAL      PIC 9(09)V9(02).        02079808
020799     05  FILLER                           PIC X(31).              02079913
020800**==================================================***           02080006
020900                                                                  02090000
021000***************************************************************   02100000
021100                                                                  02110000
021200 LINKAGE SECTION.                                                 02120000
021300***************************************************************   02130000
021400*                 * * * * * * * * *                           *   02140000
021500***************************************************************   02150000
021600***************************************************************   02160000
021700*    THIS DATA IS CALCULATED BY THIS HHAPR  SUBROUTINE        *   02170000
021800*    AND PASSED BACK TO THE CALLING PROGRAM                   *   02180000
021900***************************************************************   02190000
022000 01  HHA-INPUT-DATA.                                              02200000
022100     05  HHA-DATA.                                                02210000
022200         10  HHA-NPI                 PIC X(10).                   02220000
022300         10  HHA-HIC                 PIC X(12).                   02230000
022400         10  HHA-PROV-NO             PIC X(06).                   02240000
022500         10  HHA-TOB                 PIC XXX.                     02250000
022600         10  HHA-PEP-INDICATOR       PIC X.                       02260000
022700         10  HHA-PEP-DAYS            PIC 999.                     02270000
022800         10  HHA-INIT-PAY-INDICATOR  PIC X.                       02280000
022900         10  FILLER                  PIC X(07).                   02290000
023000         10  HHA-MSA1                PIC 9(07)V9(02).             02300000
023100         10  HHA-MSA2-DATA REDEFINES HHA-MSA1.                    02310000
023200             15  FILLER             PIC XXX.                      02320000
023300             15  HHA-MSA2.                                        02330000
023400                 25  HHA-MSA2-RURAL-1ST.                          02340000
023500                     88  HHA-MSA-RURAL-CHECK   VALUE '99'.        02350000
023600                     30  HHA-RURAL-MSA         PIC XX.            02360000
023700                 25  HHA-MSA2-RURAL-2ND        PIC XX.            02370000
023800             15  FILLER             PIC XX.                       02380000
023900         10  HHA-SERV-FROM-DATE.                                  02390000
024000             15  HHA-FROM-CC         PIC XX.                      02400000
024100             15  HHA-FROM-YYMMDD.                                 02410000
024200                 25  HHA-FROM-YY     PIC XX.                      02420000
024300                 25  HHA-FROM-MM     PIC XX.                      02430000
024400                 25  HHA-FROM-DD     PIC XX.                      02440000
024500         10  HHA-SERV-THRU-DATE.                                  02450000
024600             15  HHA-THRU-CC         PIC XX.                      02460000
024700             15  HHA-THRU-YYMMDD.                                 02470000
024800                 25  HHA-THRU-YY     PIC XX.                      02480000
024900                 25  HHA-THRU-MM     PIC XX.                      02490000
025000                 25  HHA-THRU-DD     PIC XX.                      02500000
025100         10  HHA-ADMIT-DATE.                                      02510000
025200             15  HHA-ADMIT-CC        PIC XX.                      02520000
025300             15  HHA-ADMIT-YYMMDD.                                02530000
025400                 25  HHA-ADMIT-YY    PIC XX.                      02540000
025500                 25  HHA-ADMIT-MM    PIC XX.                      02550000
025600                 25  HHA-ADMIT-DD    PIC XX.                      02560000
025700         10  HHA-HRG-DATA      OCCURS 6.                          02570000
025800             15  HHA-MED-REVIEW-INDICATOR PIC X.                  02580000
025900             15  HHA-HRG-INPUT-CODE       PIC X(05).              02590000
026000             15  HHA-HRG-OUTPUT-CODE      PIC X(05).              02600000
026100             15  HHA-HRG-NO-OF-DAYS       PIC 9(03).              02610000
026200             15  HHA-HRG-WGTS             PIC 9(02)V9(04).        02620000
026300             15  HHA-HRG-PAY              PIC 9(07)V9(02).        02630000
026400         10  HHA-REVENUE-DATA     OCCURS 6.                       02640000
026500             15  HHA-REVENUE-CODE             PIC X(04).          02650013
026600             15  HHA-REVENUE-QTY-COV-VISITS   PIC 9(03).          02660013
026610             15  HHA-REVENUE-EARLIEST-DATE    PIC 9(08).          02661013
026700             15  HHA-REVENUE-DOLL-RATE        PIC 9(07)V9(02).    02670013
026800             15  HHA-REVENUE-COST             PIC 9(07)V9(02).    02680013
026820             15  HHA-REVENUE-ADD-ON-VISIT-AMT PIC 9(07)V9(02).    02682013
026900     05  HHA-PASSBACK-DATA.                                       02690000
027000         10  HHA-PAY-RTC                PIC 99.                   02700000
027100         10  HHA-REVENUE-SUM1-3-QTY-THR PIC 9(05).                02710000
027200         10  HHA-REVENUE-SUM1-6-QTY-ALL PIC 9(05).                02720000
027300         10  HHA-OUTLIER-PAYMENT        PIC 9(07)V9(02).          02730000
027400         10  HHA-TOTAL-PAYMENT          PIC 9(07)V9(02).          02740000
027410     05  HHA-CASE-MIX-DATA.                                       02741006
027420         10  HHA-LUPA-ADD-ON-PAYMENT    PIC 9(03)V9(02).          02742006
027430         10  HHA-LUPA-SRC-ADM           PIC X.                    02743006
027440         10  HHA-RECODE-IND             PIC X.                    02744006
027450         10  HHA-EPISODE-TIMING         PIC 9.                    02745006
027460         10  HHA-SEVERITY-POINTS.                                 02746006
027470             15  HHA-CLINICAL-SEV-EQ1   PIC X(01).                02747006
027480             15  HHA-FUNCTION-SEV-EQ1   PIC X(01).                02748006
027490             15  HHA-CLINICAL-SEV-EQ2   PIC X(01).                02749006
027491             15  HHA-FUNCTION-SEV-EQ2   PIC X(01).                02749106
027492             15  HHA-CLINICAL-SEV-EQ3   PIC X(01).                02749206
027493             15  HHA-FUNCTION-SEV-EQ3   PIC X(01).                02749306
027494             15  HHA-CLINICAL-SEV-EQ4   PIC X(01).                02749406
027495             15  HHA-FUNCTION-SEV-EQ4   PIC X(01).                02749506
027496     05  HHA-PROV-TOTAL-DATA.                                     02749606
027497         10  HHA-PROV-OUTLIER-PAY-TOTAL PIC 9(08)V9(02).          02749706
027498         10  HHA-PROV-PAYMET-TOTAL      PIC 9(09)V9(02).          02749808
027499     05  FILLER                         PIC X(31).                02749913
027500**==================================================***           02750006
027600                                                                  02760000
027700 01  HOLD-VARIABLES-DATA.                                         02770000
027800     02  HOLD-VAR-DATA.                                           02780000
027900         05  PRICER-OPTION-SW                   PIC X(01).        02790000
028000         05  HHDRV-VERSION                      PIC X(07).        02800000
028100         05  HHCAL-VERSION                      PIC X(07).        02810000
028200         05  FILLER                             PIC X(20).        02820000
028300                                                                  02830000
028400 01  WAGE-INDEX-DATA.                                             02840000
028500     02  HOLD-WIR-DATA.                                           02850000
028600         05  WIR-MSA                        PIC X(04).            02860000
028700         05  WIR-EFFDATE                    PIC X(08).            02870000
028800         05  WIR-AREA-WAGEIND               PIC 9(02)V9(04).      02880000
028900                                                                  02890000
029000 PROCEDURE DIVISION  USING HHA-INPUT-DATA                         02900000
029100                           HOLD-VARIABLES-DATA                    02910000
029200                           WAGE-INDEX-DATA.                       02920000
029300                                                                  02930000
029400***************************************************************   02940000
029500*    PROCESSING:                                              *   02950000
029600*        A. WILL PROCESS NATIONAL HHA FOR FY 2001             *   02960000
029700*                STARTING OCT 1, 2000                         *   02970000
029800***************************************************************   02980000
029900                                                                  02990000
030000     MOVE CAL-VERSION TO HHCAL-VERSION.                           03000000
030100                                                                  03010000
030200     PERFORM 200-MAINLINE-CONTROL THRU 200-EXIT.                  03020000
030300                                                                  03030000
030400     MOVE HOLD-HHA-DATA TO HHA-INPUT-DATA.                        03040000
030500                                                                  03050000
030600     GOBACK.                                                      03060000
030700                                                                  03070000
030800 200-MAINLINE-CONTROL.                                            03080000
030900                                                                  03090000
031000     MOVE HHA-INPUT-DATA TO HOLD-HHA-DATA.                        03100000
031100                                                                  03110000
031200     MOVE ALL '0' TO                                              03120000
031300                     WK-ALL-TOTALS                                03130000
031400                     WK-HRG-NO-OF-DAYS                            03140000
031500                     WK-PEP-DAYS                                  03150000
031600                     H-HHA-PASSBACK-DATA                          03160000
031700                     H-HHA-HRG-PAY (1)                            03170000
031800                     H-HHA-HRG-PAY (2)                            03180000
031900                     H-HHA-HRG-PAY (3)                            03190000
032000                     H-HHA-HRG-PAY (4)                            03200000
032100                     H-HHA-HRG-PAY (5)                            03210000
032200                     H-HHA-HRG-PAY (6)                            03220000
032300                     H-HHA-REVENUE-COST (1)                       03230000
032400                     H-HHA-REVENUE-COST (2)                       03240000
032500                     H-HHA-REVENUE-COST (3)                       03250000
032600                     H-HHA-REVENUE-COST (4)                       03260000
032700                     H-HHA-REVENUE-COST (5)                       03270000
032800                     H-HHA-REVENUE-COST (6).                      03280000
032900                                                                  03290000
033000     IF  H-HHA-PAY-RTC = 00                                       03300000
033100         PERFORM 400-CALC-THE-HHA THRU 400-EXIT.                  03310000
033200                                                                  03320000
033300 200-EXIT.   EXIT.                                                03330000
033400                                                                  03340000
033500 400-CALC-THE-HHA.                                                03350000
033600                                                                  03360000
033700     IF H-HHA-SERV-FROM-DATE < 20001001 OR                        03370000
033800        H-HHA-SERV-THRU-DATE < 20001001 OR                        03380000
033900        H-HHA-ADMIT-DATE < 20001001                               03390000
034000         MOVE '40' TO H-HHA-PAY-RTC                               03400000
034100         GO TO 400-EXIT.                                          03410000
034200                                                                  03420000
034300     IF H-HHA-ADMIT-DATE >                                        03430000
034400        H-HHA-SERV-FROM-DATE                                      03440000
034500         MOVE '40' TO H-HHA-PAY-RTC                               03450000
034600         GO TO 400-EXIT.                                          03460000
034700                                                                  03470000
034800     IF ((H-HHA-TOB = '332' OR '322') AND                         03480000
034900        (H-HHA-HRG-INPUT-CODE (1) = SPACE))                       03490000
035000        MOVE '70' TO H-HHA-PAY-RTC                                03500000
035100        GO TO 400-EXIT.                                           03510000
035200                                                                  03520000
035300     IF ((H-HHA-TOB = '329' OR '339' OR '327' OR '337' OR         03530000
035310                      '32Q' OR '33Q' OR                           03531017
035400                      '32G' OR '33G' OR '32I' OR '33I' OR         03540000
035500                      '32F' OR '32K' OR '32P' OR '32H' OR         03550000
035600                      '33F' OR '33K' OR '33P' OR '33H' OR         03560000
035700                      '32J' OR '33J' OR '32M' OR '33M') AND       03570000
035800         (H-HHA-REVENUE-SUM1-6-QTY-ALL > 4 ) AND                  03580000
035900         (H-HHA-HRG-INPUT-CODE (1) = SPACE))                      03590000
036000        MOVE '75' TO H-HHA-PAY-RTC                                03600000
036100        GO TO 400-EXIT.                                           03610000
036200                                                                  03620000
036300     IF ((H-HHA-TOB = '329' OR '339' OR '327' OR '337' OR         03630000
036310                      '32Q' OR '33Q' OR                           03631017
036400                      '32G' OR '33G' OR '32I' OR '33I' OR         03640000
036500                      '32F' OR '32K' OR '32P' OR '32H' OR         03650000
036600                      '33F' OR '33K' OR '33P' OR '33H' OR         03660000
036700                      '32J' OR '33J' OR '32M' OR '33M') AND       03670000
036800         (H-HHA-REVENUE-CODE (1) = SPACE))                        03680000
036900        MOVE '85' TO H-HHA-PAY-RTC                                03690000
037000        GO TO 400-EXIT.                                           03700000
037100                                                                  03710000
037200     IF ((H-HHA-TOB = '329' OR '339' OR '327' OR '337' OR         03720000
037210                      '32Q' OR '33Q' OR                           03721017
037300                      '32G' OR '33G' OR '32I' OR '33I' OR         03730000
037400                      '32F' OR '32K' OR '32P' OR '32H' OR         03740000
037500                      '33F' OR '33K' OR '33P' OR '33H' OR         03750000
037600                      '32J' OR '33J' OR '32M' OR '33M') AND       03760000
037700         (H-HHA-HRG-INPUT-CODE (2) NOT = SPACES) AND              03770000
037800         (H-HHA-PEP-INDICATOR = 'Y') AND                          03780000
037900         (H-HHA-PEP-DAYS NOT NUMERIC OR                           03790000
038000          H-HHA-PEP-DAYS = ZEROES))                               03800000
038100        MOVE '15' TO H-HHA-PAY-RTC                                03810000
038200        GO TO 400-EXIT.                                           03820000
038300                                                                  03830000
038400     IF H-HHA-PAY-RTC NOT = 00 GO TO 400-EXIT.                    03840000
038500                                                                  03850000
038600***************************************************************   03860000
038700*    EFFECTIVE OCT 1, 2000                                    *   03870000
038800*        THESE RATES & THRESHOLDS ARE APPLIED                 *   03880000
038900***************************************************************   03890000
039000     MOVE 02115.30 TO   FED-EPISODE-RATE-AMT                      03900000
039100     MOVE 02390.29 TO   OUTLIER-THRESHOLD-AMT.                    03910000
039200***************************************************************   03920000
039300*    EFFECTIVE APR 1, 2001                                    *   03930000
039400* FOR NON-RURAL --   THESE RATES & THRESHOLDS ARE APPLIED     *   03940000
039500***************************************************************   03950000
039600     IF H-HHA-SERV-THRU-DATE > 20010331                           03960000
039700        MOVE 02161.84 TO   FED-EPISODE-RATE-AMT                   03970000
039800        MOVE 02442.88 TO   OUTLIER-THRESHOLD-AMT.                 03980000
039900***************************************************************   03990000
040000*    EFFECTIVE APR 1, 2001                                    *   04000000
040100* FOR RURAL  -- THESE RATES & THRESHOLDS ARE APPLIED          *   04010000
040200***************************************************************   04020000
040300     IF H-HHA-SERV-THRU-DATE > 20010331 AND                       04030000
040400        HHA-MSA-RURAL-CHECK                                       04040000
040500           MOVE 02378.02 TO   FED-EPISODE-RATE-AMT                04050000
040600           MOVE 02687.16 TO   OUTLIER-THRESHOLD-AMT.              04060000
040700***************************************************************   04070000
040800                                                                  04080000
040900     IF H-HHA-TOB = '322' OR '332'                                04090000
041000        PERFORM 500-INITIAL-PAYMENT THRU 500-EXIT                 04100000
041100        GO TO 400-EXIT.                                           04110000
041200                                                                  04120000
041300     IF H-HHA-TOB = '329' OR '339' OR '327' OR '337' OR           04130000
041310                    '32Q' OR '33Q' OR                             04131017
041400                    '32G' OR '33G' OR '32I' OR '33I' OR           04140000
041500                    '32F' OR '32K' OR '32P' OR '32H' OR           04150000
041600                    '33F' OR '33K' OR '33P' OR '33H' OR           04160000
041700                    '32J' OR '33J' OR '32M' OR '33M'              04170000
041800        PERFORM 1000-FINAL-PAYMENT THRU 1000-EXIT                 04180000
041900        GO TO 400-EXIT.                                           04190000
042000                                                                  04200000
042100     MOVE '10' TO H-HHA-PAY-RTC.                                  04210000
042200                                                                  04220000
042300                                                                  04230000
042400 400-EXIT.   EXIT.                                                04240000
042500                                                                  04250000
042600 500-INITIAL-PAYMENT.                                             04260000
042700                                                                  04270000
042800***************************************************************   04280000
042900*            TOB = 322 OR 332 INITIAL PAYMENT                     04290000
043000***************************************************************   04300000
043100                                                                  04310000
043200     IF  H-HHA-INIT-PAY-INDICATOR  = '1' OR '0'                   04320000
043300         NEXT SENTENCE                                            04330000
043400     ELSE                                                         04340000
043500         MOVE '35' TO H-HHA-PAY-RTC                               04350000
043600         GO TO 500-EXIT.                                          04360000
043700                                                                  04370000
043800     IF  H-HHA-INIT-PAY-INDICATOR  = '1'                          04380000
043900         MOVE '03' TO H-HHA-PAY-RTC                               04390000
044000         GO TO 500-EXIT.                                          04400000
044100                                                                  04410000
044200     COMPUTE FED-ADJ ROUNDED =                                    04420000
044300               H-HHA-HRG-WGTS (1) * FED-EPISODE-RATE-AMT.         04430000
044400                                                                  04440000
044500     COMPUTE FED-LABOR-ADJ ROUNDED =                              04450000
044600             WIR-AREA-WAGEIND *                                   04460000
044700             LABOR-PERCENT *                                      04470000
044800             FED-ADJ.                                             04480000
044900                                                                  04490000
045000     COMPUTE FED-NON-LABOR-ADJ ROUNDED =                          04500000
045100               NONLABOR-PERCENT * FED-ADJ.                        04510000
045200                                                                  04520000
045300     IF H-HHA-SERV-FROM-DATE = H-HHA-ADMIT-DATE                   04530000
045400        COMPUTE H-HHA-TOTAL-PAYMENT ROUNDED =                     04540000
045500                 (FED-LABOR-ADJ + FED-NON-LABOR-ADJ) * .6         04550000
045600        MOVE H-HHA-TOTAL-PAYMENT TO H-HHA-HRG-PAY (1)             04560000
045700        MOVE '05' TO H-HHA-PAY-RTC                                04570000
045800     ELSE                                                         04580000
045900        COMPUTE H-HHA-TOTAL-PAYMENT ROUNDED =                     04590000
046000                 (FED-LABOR-ADJ + FED-NON-LABOR-ADJ) * .5         04600000
046100        MOVE H-HHA-TOTAL-PAYMENT TO H-HHA-HRG-PAY (1)             04610000
046200        MOVE '04' TO H-HHA-PAY-RTC.                               04620000
046300                                                                  04630000
046400 500-EXIT.   EXIT.                                                04640000
046500                                                                  04650000
046600 1000-FINAL-PAYMENT.                                              04660000
046700                                                                  04670000
046800     IF H-HHA-REVENUE-QTY-COV-VISITS (1) NOT NUMERIC              04680000
046900        MOVE ZEROES TO H-HHA-REVENUE-QTY-COV-VISITS (1).          04690000
047000     IF H-HHA-REVENUE-QTY-COV-VISITS (2) NOT NUMERIC              04700000
047100        MOVE ZEROES TO H-HHA-REVENUE-QTY-COV-VISITS (2).          04710000
047200     IF H-HHA-REVENUE-QTY-COV-VISITS (3) NOT NUMERIC              04720000
047300        MOVE ZEROES TO H-HHA-REVENUE-QTY-COV-VISITS (3).          04730000
047400     IF H-HHA-REVENUE-QTY-COV-VISITS (4) NOT NUMERIC              04740000
047500        MOVE ZEROES TO H-HHA-REVENUE-QTY-COV-VISITS (4).          04750000
047600     IF H-HHA-REVENUE-QTY-COV-VISITS (5) NOT NUMERIC              04760000
047700        MOVE ZEROES TO H-HHA-REVENUE-QTY-COV-VISITS (5).          04770000
047800     IF H-HHA-REVENUE-QTY-COV-VISITS (6) NOT NUMERIC              04780000
047900        MOVE ZEROES TO H-HHA-REVENUE-QTY-COV-VISITS (6).          04790000
048000                                                                  04800000
048100     COMPUTE H-HHA-REVENUE-SUM1-3-QTY-THR ROUNDED =               04810000
048200             H-HHA-REVENUE-QTY-COV-VISITS (1) +                   04820000
048300             H-HHA-REVENUE-QTY-COV-VISITS (2) +                   04830000
048400             H-HHA-REVENUE-QTY-COV-VISITS (3).                    04840000
048500     COMPUTE H-HHA-REVENUE-SUM1-6-QTY-ALL ROUNDED =               04850000
048600             H-HHA-REVENUE-QTY-COV-VISITS (1) +                   04860000
048700             H-HHA-REVENUE-QTY-COV-VISITS (2) +                   04870000
048800             H-HHA-REVENUE-QTY-COV-VISITS (3) +                   04880000
048900             H-HHA-REVENUE-QTY-COV-VISITS (4) +                   04890000
049000             H-HHA-REVENUE-QTY-COV-VISITS (5) +                   04900000
049100             H-HHA-REVENUE-QTY-COV-VISITS (6).                    04910000
049200                                                                  04920000
049300     IF H-HHA-REVENUE-SUM1-6-QTY-ALL < 5                          04930000
049400        PERFORM 1050-LUPA THRU 1050-EXIT                          04940000
049500            VARYING SUB1 FROM 1 BY 1 UNTIL                        04950000
049600***         (H-HHA-REVENUE-CODE (SUB1) = SPACES OR                04960000
049700             SUB1 > 6                                             04970000
049800        MOVE '06' TO H-HHA-PAY-RTC                                04980000
049900        COMPUTE H-HHA-TOTAL-PAYMENT   ROUNDED =                   04990000
050000                H-HHA-REVENUE-COST (1) +                          05000000
050100                H-HHA-REVENUE-COST (2) +                          05010000
050200                H-HHA-REVENUE-COST (3) +                          05020000
050300                H-HHA-REVENUE-COST (4) +                          05030000
050400                H-HHA-REVENUE-COST (5) +                          05040000
050500                H-HHA-REVENUE-COST (6)                            05050000
050600        GO TO 1000-EXIT.                                          05060000
050700                                                                  05070000
050800     IF (H-HHA-PEP-INDICATOR NOT = 'Y' AND NOT = 'N')             05080000
050900         MOVE '20' TO H-HHA-PAY-RTC                               05090000
051000         GO TO 1000-EXIT.                                         05100000
051100                                                                  05110000
051200*********  HRG  PAYMENT   *******************                     05120000
051300                                                                  05130000
051400***  IF H-HHA-REVENUE-SUM1-3-QTY-THR > 9                          05140000
051500        IF H-HHA-HRG-INPUT-CODE (2) = SPACES                      05150000
051600           IF H-HHA-PEP-INDICATOR = 'N'                           05160000
051700              PERFORM 3000-PEP-N-ADJUST THRU 3000-EXIT            05170000
051800                  VARYING CO1 FROM 1 BY 1 UNTIL                   05180000
051900*                 (H-HHA-HRG-INPUT-CODE (CO1) = SPACES OR         05190000
052000                   CO1 > 6                                        05200000
052100               PERFORM 7000-OUTLIER-PAYMENT THRU 7000-EXIT        05210000
052200               GO TO 1000-EXIT.                                   05220000
052300                                                                  05230000
052400                                                                  05240000
052500***  IF H-HHA-REVENUE-SUM1-3-QTY-THR > 9                          05250000
052600        IF H-HHA-HRG-INPUT-CODE (2) = SPACES                      05260000
052700           IF H-HHA-PEP-INDICATOR = 'Y'                           05270000
052800              PERFORM 4000-PEP-Y-ADJUST THRU 4000-EXIT            05280000
052900                  VARYING CO1 FROM 1 BY 1 UNTIL                   05290000
053000*                 (H-HHA-HRG-INPUT-CODE (CO1) = SPACES OR         05300000
053100                   CO1 > 6                                        05310000
053200               PERFORM 7000-OUTLIER-PAYMENT THRU 7000-EXIT        05320000
053300               GO TO 1000-EXIT.                                   05330000
053400                                                                  05340000
053500**** IF H-HHA-REVENUE-SUM1-3-QTY-THR > 9                          05350000
053600        IF H-HHA-HRG-INPUT-CODE (2) NOT = SPACES                  05360000
053700           IF H-HHA-PEP-INDICATOR = 'N'                           05370000
053800              PERFORM 5000-PEP-N-ADJUST THRU 5000-EXIT            05380000
053900                  VARYING CO1 FROM 1 BY 1 UNTIL                   05390000
054000*                 (H-HHA-HRG-INPUT-CODE (CO1) = SPACES OR         05400000
054100                   CO1 > 6                                        05410000
054200               PERFORM 7000-OUTLIER-PAYMENT THRU 7000-EXIT        05420000
054300               GO TO 1000-EXIT.                                   05430000
054400                                                                  05440000
054500**** IF H-HHA-REVENUE-SUM1-3-QTY-THR > 9                          05450000
054600        IF H-HHA-HRG-INPUT-CODE (2) NOT = SPACES                  05460000
054700           IF H-HHA-PEP-INDICATOR = 'Y'                           05470000
054800              PERFORM 6000-PEP-Y-ADJUST THRU 6000-EXIT            05480000
054900                  VARYING CO1 FROM 1 BY 1 UNTIL                   05490000
055000*                 (H-HHA-HRG-INPUT-CODE (CO1) = SPACES OR         05500000
055100                   CO1 > 6                                        05510000
055200               PERFORM 7000-OUTLIER-PAYMENT THRU 7000-EXIT        05520000
055300               GO TO 1000-EXIT.                                   05530000
055400                                                                  05540000
055500                                                                  05550000
055600      MOVE '20' TO H-HHA-PAY-RTC.                                 05560000
055700                                                                  05570000
055800 1000-EXIT.  EXIT.                                                05580000
055900 1050-LUPA.                                                       05590000
056000                                                                  05600000
056100***************************************************************   05610000
056200*                    LUPA PAYMENT                                 05620000
056300***************************************************************   05630000
056400                                                                  05640000
056500     IF H-HHA-REVENUE-CODE (SUB1) = SPACES                        05650000
056600        MOVE 6 TO SUB1                                            05660000
056700        GO TO 1050-EXIT.                                          05670000
056800                                                                  05680000
056900     COMPUTE FED-ADJ ROUNDED =                                    05690000
057000             H-HHA-REVENUE-QTY-COV-VISITS (SUB1) *                05700000
057100             H-HHA-REVENUE-DOLL-RATE (SUB1).                      05710000
057200                                                                  05720000
057300     COMPUTE FED-LABOR-ADJ ROUNDED =                              05730000
057400             WIR-AREA-WAGEIND *                                   05740000
057500             LABOR-PERCENT *                                      05750000
057600             FED-ADJ.                                             05760000
057700                                                                  05770000
057800     COMPUTE FED-NON-LABOR-ADJ ROUNDED =                          05780000
057900             NONLABOR-PERCENT *                                   05790000
058000             FED-ADJ.                                             05800000
058100                                                                  05810000
058200     COMPUTE H-HHA-REVENUE-COST (SUB1) ROUNDED =                  05820000
058300             (FED-LABOR-ADJ + FED-NON-LABOR-ADJ).                 05830000
058400                                                                  05840000
058500 1050-EXIT.   EXIT.                                               05850000
058600                                                                  05860000
058700                                                                  05870000
058800 3000-PEP-N-ADJUST.                                               05880000
058900                                                                  05890000
059000***************************************************************   05900000
059100*           HRG OCCUR < 2 AND PEP = N ADJUSTMENT                  05910000
059200***************************************************************   05920000
059300                                                                  05930000
059400     IF H-HHA-HRG-INPUT-CODE (CO1) = SPACES                       05940000
059500        MOVE 6 TO SUB1                                            05950000
059600        GO TO 3000-EXIT.                                          05960000
059700                                                                  05970000
059800     MOVE H-HHA-HRG-NO-OF-DAYS (CO1) TO WK-HRG-NO-OF-DAYS.        05980001
059900                                                                  05990000
060000     COMPUTE FED-ADJ ROUNDED =                                    06000000
060100               (WK-HRG-NO-OF-DAYS / 60) *                         06010000
060200               H-HHA-HRG-WGTS (CO1) * FED-EPISODE-RATE-AMT.       06020000
060300                                                                  06030000
060400     COMPUTE FED-LABOR-ADJ ROUNDED =                              06040000
060500               WIR-AREA-WAGEIND *                                 06050000
060600               LABOR-PERCENT * FED-ADJ.                           06060000
060700                                                                  06070000
060800     COMPUTE FED-NON-LABOR-ADJ ROUNDED =                          06080000
060900               NONLABOR-PERCENT * FED-ADJ.                        06090000
061000                                                                  06100000
061100     COMPUTE WK-3000-PEP-N-PAYMENT ROUNDED =                      06110000
061200              (FED-LABOR-ADJ + FED-NON-LABOR-ADJ).                06120000
061300                                                                  06130000
061400     COMPUTE H-HHA-HRG-PAY (CO1) ROUNDED =                        06140000
061500             WK-3000-PEP-N-PAYMENT.                               06150000
061600                                                                  06160000
061700     COMPUTE WK-3000-PEP-N-PRETOT-PAY ROUNDED =                   06170000
061800             WK-3000-PEP-N-PRETOT-PAY + WK-3000-PEP-N-PAYMENT.    06180000
061900                                                                  06190000
062000                                                                  06200000
062100 3000-EXIT.   EXIT.                                               06210000
062200                                                                  06220000
062300 4000-PEP-Y-ADJUST.                                               06230000
062400                                                                  06240000
062500***************************************************************   06250000
062600*           HRG OCCUR < 2 AND PEP = Y ADJUSTMENT                  06260000
062700***************************************************************   06270000
062800                                                                  06280000
062900     IF H-HHA-HRG-INPUT-CODE (CO1) = SPACES                       06290000
063000        MOVE 6 TO SUB1                                            06300000
063100        GO TO 4000-EXIT.                                          06310000
063200                                                                  06320000
063300     MOVE H-HHA-HRG-NO-OF-DAYS (CO1) TO WK-HRG-NO-OF-DAYS.        06330001
063400                                                                  06340000
063500     COMPUTE FED-ADJ ROUNDED =                                    06350000
063600               (WK-HRG-NO-OF-DAYS / 60) *                         06360000
063700               H-HHA-HRG-WGTS (CO1) * FED-EPISODE-RATE-AMT.       06370000
063800                                                                  06380000
063900     COMPUTE FED-LABOR-ADJ ROUNDED =                              06390000
064000               WIR-AREA-WAGEIND *                                 06400000
064100               LABOR-PERCENT * FED-ADJ.                           06410000
064200                                                                  06420000
064300     COMPUTE FED-NON-LABOR-ADJ ROUNDED =                          06430000
064400               NONLABOR-PERCENT * FED-ADJ.                        06440000
064500                                                                  06450000
064600     COMPUTE WK-4000-PEP-Y-PAYMENT ROUNDED =                      06460000
064700              (FED-LABOR-ADJ + FED-NON-LABOR-ADJ).                06470000
064800                                                                  06480000
064900     COMPUTE H-HHA-HRG-PAY (CO1) ROUNDED =                        06490000
065000             WK-4000-PEP-Y-PAYMENT.                               06500000
065100                                                                  06510000
065200                                                                  06520000
065300     COMPUTE WK-4000-PEP-Y-PRETOT-PAY ROUNDED =                   06530000
065400             WK-4000-PEP-Y-PRETOT-PAY + WK-4000-PEP-Y-PAYMENT.    06540000
065500                                                                  06550000
065600                                                                  06560000
065700                                                                  06570000
065800 4000-EXIT.   EXIT.                                               06580000
065900 5000-PEP-N-ADJUST.                                               06590000
066000                                                                  06600000
066100***************************************************************   06610000
066200*           HRG OCCUR > 1 AND PEP = N ADJUSTMENT                  06620000
066300***************************************************************   06630000
066400                                                                  06640000
066500     IF H-HHA-HRG-INPUT-CODE (CO1) = SPACES                       06650000
066600        MOVE 6 TO SUB1                                            06660000
066700        GO TO 5000-EXIT.                                          06670000
066800                                                                  06680000
066900     MOVE H-HHA-HRG-NO-OF-DAYS (CO1) TO WK-HRG-NO-OF-DAYS.        06690001
067000                                                                  06700000
067100     COMPUTE FED-ADJ ROUNDED =                                    06710000
067200               (WK-HRG-NO-OF-DAYS / 60) *                         06720000
067300               H-HHA-HRG-WGTS (CO1) * FED-EPISODE-RATE-AMT.       06730000
067400                                                                  06740000
067500     COMPUTE FED-LABOR-ADJ ROUNDED =                              06750000
067600               WIR-AREA-WAGEIND *                                 06760000
067700               LABOR-PERCENT * FED-ADJ.                           06770000
067800                                                                  06780000
067900     COMPUTE FED-NON-LABOR-ADJ ROUNDED =                          06790000
068000               NONLABOR-PERCENT * FED-ADJ.                        06800000
068100                                                                  06810000
068200     COMPUTE WK-5000-PEP-N-PAYMENT ROUNDED =                      06820000
068300              (FED-LABOR-ADJ + FED-NON-LABOR-ADJ).                06830000
068400                                                                  06840000
068500     COMPUTE H-HHA-HRG-PAY (CO1) ROUNDED =                        06850000
068600             WK-5000-PEP-N-PAYMENT.                               06860000
068700                                                                  06870000
068800                                                                  06880000
068900     COMPUTE WK-5000-PEP-N-PRETOT-PAY ROUNDED =                   06890000
069000             WK-5000-PEP-N-PRETOT-PAY + WK-5000-PEP-N-PAYMENT.    06900000
069100                                                                  06910000
069200                                                                  06920000
069300 5000-EXIT.   EXIT.                                               06930000
069400 6000-PEP-Y-ADJUST.                                               06940000
069500                                                                  06950000
069600***************************************************************   06960000
069700*           HRG OCCUR > 1 AND PEP = Y SHORTENED EPISODE           06970000
069800***************************************************************   06980000
069900                                                                  06990000
070000     IF H-HHA-HRG-INPUT-CODE (CO1) = SPACES                       07000000
070100        MOVE 6 TO SUB1                                            07010000
070200        GO TO 6000-EXIT.                                          07020000
070300                                                                  07030000
070400     MOVE H-HHA-HRG-NO-OF-DAYS (CO1) TO WK-HRG-NO-OF-DAYS.        07040001
070500     MOVE H-HHA-PEP-DAYS             TO WK-PEP-DAYS.              07050000
070600                                                                  07060000
070700     COMPUTE FED-ADJ ROUNDED =                                    07070000
070800         (WK-HRG-NO-OF-DAYS / WK-PEP-DAYS)                        07080000
070900                                 *                                07090000
071000                     ((WK-PEP-DAYS / 60)                          07100000
071100                                 *                                07110000
071200           (H-HHA-HRG-WGTS (CO1) * FED-EPISODE-RATE-AMT)).        07120000
071300                                                                  07130000
071400                                                                  07140000
071500     COMPUTE FED-LABOR-ADJ ROUNDED =                              07150000
071600               WIR-AREA-WAGEIND *                                 07160000
071700               LABOR-PERCENT * FED-ADJ.                           07170000
071800                                                                  07180000
071900     COMPUTE FED-NON-LABOR-ADJ ROUNDED =                          07190000
072000               NONLABOR-PERCENT * FED-ADJ.                        07200000
072100                                                                  07210000
072200     COMPUTE WK-6000-PEP-Y-PAYMENT ROUNDED =                      07220000
072300              (FED-LABOR-ADJ + FED-NON-LABOR-ADJ).                07230000
072400                                                                  07240000
072500     COMPUTE H-HHA-HRG-PAY (CO1) ROUNDED =                        07250000
072600             WK-6000-PEP-Y-PAYMENT.                               07260000
072700                                                                  07270000
072800     COMPUTE WK-6000-PEP-Y-PRETOT-PAY ROUNDED =                   07280000
072900             WK-6000-PEP-Y-PRETOT-PAY + WK-6000-PEP-Y-PAYMENT.    07290000
073000                                                                  07300000
073100                                                                  07310000
073200 6000-EXIT.   EXIT.                                               07320000
073300                                                                  07330000
073400 7000-OUTLIER-PAYMENT.                                            07340000
073500                                                                  07350000
073600***************************************************************   07360000
073700*                    OUTLIER PAYMENT                              07370000
073800***************************************************************   07380000
073900     COMPUTE OUT-THRES-LABOR-ADJ ROUNDED =                        07390000
074000               WIR-AREA-WAGEIND *                                 07400000
074100               LABOR-PERCENT * OUTLIER-THRESHOLD-AMT.             07410000
074200                                                                  07420000
074300     COMPUTE OUT-THRES-NON-LABOR-ADJ ROUNDED =                    07430000
074400               NONLABOR-PERCENT * OUTLIER-THRESHOLD-AMT.          07440000
074500                                                                  07450000
074600     COMPUTE OUT-THRES-AMT-ADJ ROUNDED  =                         07460000
074700             (OUT-THRES-LABOR-ADJ +                               07470000
074800              OUT-THRES-NON-LABOR-ADJ).                           07480000
074900                                                                  07490000
075000      COMPUTE WK-7000-OUTLIER-VALUE-A ROUNDED =                   07500000
075100              OUT-THRES-AMT-ADJ +                                 07510000
075200             WK-3000-PEP-N-PRETOT-PAY +                           07520000
075300             WK-4000-PEP-Y-PRETOT-PAY +                           07530000
075400             WK-5000-PEP-N-PRETOT-PAY +                           07540000
075500             WK-6000-PEP-Y-PRETOT-PAY.                            07550000
075600                                                                  07560000
075700      PERFORM 8000-ADD-REV-DOLL THRU 8000-EXIT                    07570000
075800                  VARYING CO1 FROM 1 BY 1 UNTIL                   07580000
075900                   CO1 > 6.                                       07590000
076000                                                                  07600000
076100      COMPUTE WK-7000-AB-DIFF ROUNDED =                           07610000
076200              WK-8000-OUTLIER-VALUE-B - WK-7000-OUTLIER-VALUE-A.  07620000
076300                                                                  07630000
076400      IF WK-7000-AB-DIFF > ZERO                                   07640000
076500         COMPUTE WK-7000-CALC ROUNDED =                           07650000
076600               OUTL-LOSS-SHAR-RATIO-PERCENT * WK-7000-AB-DIFF     07660000
076700         COMPUTE H-HHA-OUTLIER-PAYMENT ROUNDED =                  07670000
076800               WK-7000-CALC                                       07680000
076900         COMPUTE H-HHA-TOTAL-PAYMENT ROUNDED =                    07690000
077000                (WK-7000-CALC +                                   07700000
077100                 WK-3000-PEP-N-PRETOT-PAY +                       07710000
077200                 WK-4000-PEP-Y-PRETOT-PAY +                       07720000
077300                 WK-5000-PEP-N-PRETOT-PAY +                       07730000
077400                 WK-6000-PEP-Y-PRETOT-PAY)                        07740000
077500          MOVE '01' TO H-HHA-PAY-RTC                              07750000
077600      ELSE                                                        07760000
077700         COMPUTE H-HHA-TOTAL-PAYMENT ROUNDED =                    07770000
077800                (WK-3000-PEP-N-PRETOT-PAY +                       07780000
077900                 WK-4000-PEP-Y-PRETOT-PAY +                       07790000
078000                 WK-5000-PEP-N-PRETOT-PAY +                       07800000
078100                 WK-6000-PEP-Y-PRETOT-PAY)                        07810000
078200          MOVE '00' TO H-HHA-PAY-RTC.                             07820000
078300                                                                  07830000
078400                                                                  07840000
078500 7000-EXIT.   EXIT.                                               07850000
078600 8000-ADD-REV-DOLL.                                               07860000
078700                                                                  07870000
078800***************************************************************   07880000
078900*        ADD ALL REVENUE DOLLARS                                  07890000
079000***************************************************************   07900000
079100                                                                  07910000
079200     IF H-HHA-REVENUE-CODE (CO1) = SPACES                         07920000
079300        MOVE 6 TO SUB1                                            07930000
079400        GO TO 8000-EXIT.                                          07940000
079500                                                                  07950000
079600     COMPUTE FED-ADJ ROUNDED =                                    07960000
079700                H-HHA-REVENUE-DOLL-RATE (CO1) *                   07970000
079800                H-HHA-REVENUE-QTY-COV-VISITS (CO1).               07980000
079900                                                                  07990000
080000     COMPUTE FED-LABOR-ADJ ROUNDED =                              08000000
080100               WIR-AREA-WAGEIND *                                 08010000
080200               LABOR-PERCENT * FED-ADJ.                           08020000
080300                                                                  08030000
080400     COMPUTE FED-NON-LABOR-ADJ ROUNDED =                          08040000
080500               NONLABOR-PERCENT * FED-ADJ.                        08050000
080600                                                                  08060000
080700     COMPUTE WK-8000-OUTLIER-LAB-NLAB ROUNDED =                   08070000
080800              (FED-LABOR-ADJ + FED-NON-LABOR-ADJ).                08080000
080900                                                                  08090000
081000                                                                  08100000
081100     COMPUTE H-HHA-REVENUE-COST (CO1) ROUNDED =                   08110000
081200               WK-8000-OUTLIER-LAB-NLAB.                          08120000
081300                                                                  08130000
081400     COMPUTE WK-8000-OUTLIER-VALUE-B ROUNDED =                    08140000
081500             WK-8000-OUTLIER-VALUE-B + WK-8000-OUTLIER-LAB-NLAB.  08150000
081600                                                                  08160000
081700 8000-EXIT.   EXIT.                                               08170000
081800                                                                  08180000
081900******        L A S T   S O U R C E   S T A T E M E N T   *****   08190000
